home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / xlisp_21.zoo / xl-005.bug < prev    next >
Internet Message Format  |  1990-02-28  |  3KB
  1. From sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma Wed Jan 17 09:56:12 EST 1990
  2. Article: 53 of comp.lang.lisp.x
  3. Path: cognos!sce!mitel!uunet!zephyr.ens.tek.com!tekcrl!tekgvs!toma
  4. From: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  5. Newsgroups: comp.lang.lisp.x
  6. Subject: Some More bug fixes
  7. Message-ID: <6670@tekgvs.LABS.TEK.COM>
  8. Date: 15 Jan 90 18:27:05 GMT
  9. Reply-To: toma@tekgvs.LABS.TEK.COM (Tom Almy)
  10. Organization: Tektronix, Inc., Beaverton,  OR.
  11. Lines: 134
  12.  
  13. These problems were pointed out to me by Paul van Niekerk 
  14. (nikkie@duteca2.tudelft.nl). They are applicable to XLISP versions 2.0 or 2.1.
  15.  
  16. PROBLEM: (last '(a b . c)) returns c rather than (b . c)
  17. SOLUTION: in xllist.c, replace xlast with:
  18.  
  19. /* xlast - return the last cons of a list */
  20. LVAL xlast()
  21. {
  22.     LVAL list;
  23.  
  24.     /* get the list */
  25.     list = xlgalist();
  26.     xllastarg();
  27.  
  28.     /* find the last cons */
  29.     if (consp(list))
  30.         while (consp(cdr(list))) list = cdr(list);
  31.  
  32.     /* return the last element */
  33.     return (list);
  34. }
  35.  
  36. PROBLEM: functions boundp, fboundp, symbol-name, symbol-value, and 
  37. symbol-plist fail on NIL (which *is* a symbol), and symbol-function fails 
  38. improperly (wrong error message).
  39.  
  40. SOLUTION:
  41.  
  42. In xlisp.h, add:
  43.  
  44. #define xlgasymornil()    (*xlargv==NIL || symbolp(*xlargv) ? nextarg() : xlbadtype(*xlargv))
  45.  
  46. In xlbfun.c, change functions to the following:
  47.  
  48. /* xboundp - is this a value bound to this symbol? */
  49. LVAL xboundp()
  50. {
  51.     LVAL sym;
  52.     sym = xlgasymornil();
  53.     xllastarg();
  54.     return (sym == NIL || boundp(sym) ? true : NIL);
  55. }
  56.  
  57. /* xfboundp - is this a functional value bound to this symbol? */
  58. LVAL xfboundp()
  59. {
  60.     LVAL sym;
  61.     sym = xlgasymornil();
  62.     xllastarg();
  63.     return (sym != NIL && fboundp(sym) ? true : NIL);
  64. }
  65.  
  66. /* xsymname - get the print name of a symbol */
  67. LVAL xsymname()
  68. {
  69.     LVAL sym;
  70.  
  71.     /* get the symbol */
  72.     sym = xlgasymornil();
  73.     xllastarg();
  74.  
  75.     /* handle NIL, which is not internally represented as a symbol */
  76.     if (sym == NIL) {
  77.         sym = newstring(4);
  78.         strcpy(getstring(sym), "NIL");
  79.         return sym;
  80.     }
  81.  
  82.     /* return the print name */
  83.     return (getpname(sym));
  84. }
  85.  
  86. /* xsymvalue - get the value of a symbol */
  87. LVAL xsymvalue()
  88. {
  89.     LVAL sym,val;
  90.  
  91.     /* get the symbol */
  92.     sym = xlgasymornil();
  93.     xllastarg();
  94.  
  95.     /* handle NIL */
  96.     if (sym == NIL) return (NIL);
  97.  
  98.     /* get the global value */
  99.     while ((val = getvalue(sym)) == s_unbound)
  100.         xlunbound(sym);
  101.  
  102.     /* return its value */
  103.     return (val);
  104. }
  105.  
  106. /* xsymfunction - get the functional value of a symbol */
  107. LVAL xsymfunction()
  108. {
  109.     LVAL sym,val;
  110.  
  111.     /* get the symbol */
  112.     sym = xlgasymornil();
  113.     xllastarg();
  114.  
  115.     /* handle NIL */
  116.     if (sym == NIL) {
  117.         while (1)
  118.             xlfunbound(sym);
  119.     }
  120.  
  121.  
  122.     /* get the global value */
  123.     while ((val = getfunction(sym)) == s_unbound)
  124.         xlfunbound(sym);
  125.  
  126.     /* return its value */
  127.     return (val);
  128. }
  129.  
  130. /* xsymplist - get the property list of a symbol */
  131. LVAL xsymplist()
  132. {
  133.     LVAL sym;
  134.  
  135.     /* get the symbol */
  136.     sym = xlgasymornil();
  137.     xllastarg();
  138.  
  139.     /* return the property list */
  140.     return (sym == NIL ? NIL : getplist(sym));
  141. }
  142.  
  143.  
  144. Tom Almy
  145. toma@tekgvs.labs.tek.com
  146. Standard Disclaimers Apply
  147.  
  148.  
  149.